home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 011 / device2.arc / DEVICE.PAS < prev   
Pascal/Delphi Source File  |  1984-01-01  |  10KB  |  314 lines
  1. program Print_Device_Driver_Chain(input,output);
  2. {*********************************************************************
  3.  * DEVICE.PAS             program for displaying device driver chain *
  4.  *                        for DOS 2.00,2.10,3.00,3.10                *
  5.  *                                                                   *
  6.  * by Tim MacNary         july 13,1985                               *
  7.  *                        Turbo Pascal v. 2.00B PC-DOS               *
  8.  *                                                                   *
  9.  * Adapted from a Lattice C program by Stan Mitchell, published in   *
  10.  * Dr. Dobb's Journal, #103 May, 1985, page 122.                     *
  11.  * Please keep this comment here.                                    *
  12.  *********************************************************************
  13.     This routine uses fields of a standard FCB that Microsoft, in
  14.  it's wisdom, declined to make public. Contained in each opened FCB
  15.  are a Segment:Offset pair that point to the device drive used to
  16.  access the opened file: if you open a disk file, then the driver
  17.  interface to the disk drives is used; if the CON: device, then
  18.  the console driver is used.
  19.     DOS keeps track of the drivers by means of a linked list. Each
  20.  driver has a header area which defines what that device can do, it's
  21.  name, where it's entry points are, and the address of the next driver
  22.  in the list. There is one special driver in the list: the NUL: device.
  23.  It is always at the beginning of the list, so all other drivers will
  24.  follow it.
  25.      The routine is as follows:
  26.  
  27. begin
  28.    Determine what DOS version being used
  29.    Exit if the version = 0 ( means dos 1.xx )
  30.    Initial an FCB with the NUL: device name.
  31.    Open the file; exit if error.
  32.    Get the pointers from the FCB; the pointers are in different places
  33.      for DOS 2 and 3.
  34.    Set up the screen --make it look nice
  35.    Repeat
  36.       Output the header
  37.       Get the next header
  38.    Until the next header offset field = $FFFF
  39.    Output the last header
  40.    Finish the screen display
  41. end
  42.  
  43. }
  44.  
  45. const
  46.  
  47.    { DOS Function codes }
  48.    OpenFCB  = $0F00;
  49.    CloseFCB = $1000;
  50.    DOS_Version  = $3000;
  51.  
  52. type
  53.    DevHdr = record
  54.       Next_Hdr_Offs,
  55.       Next_Hdr_Seg,
  56.       Attributes,
  57.       Strategy,
  58.       Interrupt:integer;
  59.       Dev_Name:array[1..8] of char;
  60.    end;
  61.  
  62.    DevHdr_Ptr = ^DevHdr;
  63.  
  64.    { The next two record types are used to access the pointers in
  65.      the FCB }
  66.  
  67.    Reserve_V2 = record
  68.       time: integer;
  69.       attribute : byte;
  70.       device_header_offset, device_header_segment: integer;
  71.       Unknown : array[1..3] of byte;
  72.    end;
  73.  
  74.    Reserve_V3 = record
  75.       time: integer;
  76.       attribute : integer;
  77.       device_header_offset, device_header_segment: integer;
  78.       Unknown : array[1..2] of byte;
  79.    end;
  80.  
  81.    NameType = array[1..11] of char;
  82.  
  83.    FCB_Type = record
  84.       drive:byte;
  85.       fname:NameType;
  86.       current_block :integer;
  87.       record_size: integer;
  88.       file_size: array[1..2] of integer;
  89.       date: integer;
  90.       RSU: array[1..10] of byte; { This is where the device pointer is stored }
  91.       bset : array[1..5] of byte;
  92.    end;
  93.  
  94.  
  95. var
  96.    device : DevHdr_Ptr;
  97.    file_control_block : FCB_Type;
  98.    rsv2_x: ^reserve_V2;
  99.    rsv3_x: ^reserve_V3;
  100.    Error:integer;
  101.    Hdr_Seg,Hdr_Offs:integer;
  102.    Version,Minor:integer;
  103.  
  104. procedure Init_FCB(Drive:byte;Name:NameType;var File_Control_Block:FCB_Type);
  105.  
  106. { Fill in the Drive and File fields of the FCB.
  107.   Returns an initialized File Control Block. }
  108.  
  109. begin
  110.    File_Control_Block.Drive:=Drive;
  111.    File_Control_Block.FName:=Name;
  112. end; { Init_FCB }
  113.  
  114. procedure Open_Device(var File_Control_Block:FCB_Type;var Error:integer);
  115.  
  116. { The equivalent of either a reset or a rewrite in Turbo Pascal }
  117.  
  118. var  Regs: record
  119.              AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags:integer;
  120.           end;
  121. begin
  122.    Regs.DS:=SEG(File_Control_Block);
  123.    Regs.DX:=OFS(File_Control_Block);
  124.    Regs.AX:=OpenFCB;
  125.    MSDOS(Regs);
  126.    Error:=LO(Regs.AX);
  127. end;
  128.  
  129. procedure Hex_Output(Value:integer);
  130.  
  131. { Convert value to a hex string and output it, right-justified in a
  132.   4 character field. }
  133.  
  134. var  Rem:integer;
  135.      OutStr:string[4];
  136. begin
  137.    OutStr:='';
  138.  
  139.    repeat
  140.       Rem:=Value MOD 16;     { Get remainder }
  141.       Value:=Value DIV 16;   { calculate quotient }
  142.  
  143.       { Convert to A-F if necessary }
  144.       if Rem > 9 then OutStr:=CHR(Rem + ORD('A') - 10 ) + OutStr
  145.       else OutStr:=CHR(Rem + ORD('0')) + OutStr;
  146.    until Value = 0;
  147.  
  148.    { Justify the answer a la Turbo }
  149.    for Rem:=1 TO 4 - Length(OutStr) DO
  150.       write(' ');
  151.    write(OutStr);
  152.  
  153. end { Hex_Output };
  154.  
  155. procedure Print_Header(Dev:DevHdr_Ptr;Hdr_Seg,Hdr_Offs:integer);
  156.  
  157. { Print a device driver header }
  158.  
  159. type Str4=string[4];
  160. var  Co,Co2:integer;
  161.  
  162. procedure WriteIfEqual(Attributes,Mask:integer;Str:Str4;var Co:integer);
  163.  
  164. { If an attribute is present, then print out a 4 character attribute indicator. }
  165.  
  166. begin
  167.    if Attributes AND Mask <> 0 then
  168.    begin
  169.       write(Str);
  170.       Co:=Co + 1
  171.    end
  172. end;
  173.  
  174. begin
  175.    Co:=0;
  176.    write('│ ');
  177.    Hex_Output(Hdr_Seg);
  178.    write('    │');
  179.    Hex_Output(Hdr_Offs);
  180.    write('   │ ');
  181.    WITH Dev^ DO
  182.    begin
  183.       if (Attributes AND $8000) = 0000 then { Block device }
  184.       begin
  185.          write('# Blocks:');
  186.          { write out block number}
  187.          write(ORD(Dev_Name[1]):2);
  188.          write(' │         ');
  189.       end
  190.       else begin
  191.          WriteIfEqual(Attributes,$0001,'StI ',Co);
  192.          WriteIfEqual(Attributes,$0002,'StO ',Co);
  193.          WriteIfEqual(Attributes,$0004,'Nul ',Co);
  194.          WriteIfEqual(Attributes,$0008,'Clk ',Co);
  195.          WriteIfEqual(Attributes,$0010,'Spl ',Co);
  196.          WriteIfEqual(Attributes,$4000,'IOC ',Co);
  197.          for Co2 := 1 TO (3-Co) DO write('    ');
  198.          write('│ ');
  199.          for Co:=1 TO 8 DO write(Dev_Name[Co]); { Character device }
  200.       end;
  201.       write(' │');
  202.       Hex_Output(Strategy);
  203.       write('     │');
  204.       Hex_Output(Interrupt);
  205.       write('      │')
  206.    end;
  207.    writeln
  208. end;
  209.  
  210. procedure Get_DOS_Version(var Major,Minor:integer);
  211.  
  212. { Call MS-DOS to get the dos version number. The two returned values should
  213.   be displayed: write(Major:1,'.',Minor:2);  Dos 1.xx will return a major
  214.   version number of 0. }
  215.  
  216. var  Regs: record
  217.              AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags:integer;
  218.           end;
  219. begin
  220.    Regs.AX:=DOS_Version;
  221.    MSDOS(Regs);
  222.    Major:=LO(Regs.AX);
  223.    Minor:=HI(Regs.AX);
  224. end;
  225.  
  226. procedure Set_Up_Screen(Version,Minor:integer);
  227.  
  228. { Write out the column headers, etc }
  229.  
  230. begin
  231.    write(  '                      ');
  232.    TEXTCOLOR(BLACK);
  233.    TEXTBACKGROUND(WHITE);
  234.    writeln('╔═════════════════════╗');
  235.    TEXTCOLOR(WHITE);
  236.    TEXTBACKGROUND(BLACK);
  237.    write(  '                      ');
  238.    TEXTCOLOR(BLACK);
  239.    TEXTBACKGROUND(WHITE);
  240.    writeln('║ Device Driver Chain ║');
  241.    writeln('╒═════════════════════╩═════════════════════╩═══════════════════╕');
  242.    writeln('│ DOS Version ',Version:1,'.',Minor:2,'                                              │');
  243.    writeln('├───────────────────────────────────────────────────────────────┤');
  244.    writeln('│ Segment  Offset  Attributes    Name       Strategy  Interrupt │');
  245.    writeln('├─────────┬───────┬─────────────┬──────────┬─────────┬──────────┤');
  246. end; { Set_Up_Screen }
  247.  
  248. procedure Finish_Screen;
  249. begin
  250.    writeln('├─────────┴───────┴─────────────┴──────────┴─────────┴──────────┤');
  251.    writeln('│ StI=Standard Input  StO=Standard Output  Nul=Nul Device       │');
  252.    writeln('│ Spl=Special  Clk=Clock  IOC=Input/Output Control              │');
  253.    writeln('└───────────────────────────────────────────────────────────────┘');
  254. end; { Finish_Screen }
  255.  
  256. begin
  257.    Get_DOS_Version(Version,Minor);
  258.    if Version = 0 then { DOS 1.xx used }
  259.    begin
  260.       writeln('MS-DOS 2.xx or 3.xx required; exiting ...');
  261.       repeat until KEYPRESSED;
  262.       HALT
  263.    end;
  264.  
  265.    { Get nul: header location by Opening it; the FCB has fields containing
  266.      the SEG:OFS of the NUL device. }
  267.    Init_FCB(0,'NUL        ',File_Control_Block);
  268.    Open_Device(File_Control_Block,Error);
  269.  
  270.    if Error = 0 then   { Nul device opened successfully }
  271.    begin
  272.       case Version of { DOS 2.xx and 3.xx allocate the FCB differently }
  273.          2: { DOS 2.xx }
  274.             begin
  275.                rsv2_x:=PTR(SEG(File_Control_Block),
  276.                            OFS(File_Control_Block)+22);
  277.                Device:=PTR(rsv2_x^.Device_Header_Segment,
  278.                            rsv2_x^.Device_Header_Offset);
  279.                Hdr_Seg :=rsv2_x^.Device_Header_Segment;
  280.                Hdr_Offs:=rsv2_x^.Device_Header_Offset;
  281.             end;
  282.          3: { DOS 3.xx }
  283.             begin
  284.                rsv3_x:=PTR(SEG(File_Control_Block),
  285.                            OFS(File_Control_Block)+22);
  286.                Device:=PTR(rsv3_x^.Device_Header_Segment,
  287.                            rsv3_x^.Device_Header_Offset);
  288.                Hdr_Seg :=rsv3_x^.Device_Header_Segment;
  289.                Hdr_Offs:=rsv3_x^.Device_Header_Offset;
  290.             end;
  291.          else begin
  292.             writeln('DOS Version ',Version:2,'.',Minor:2,' not supported.');
  293.             halt;
  294.          end;
  295.       end; { case }
  296.  
  297.       Set_Up_Screen(Version,Minor);
  298.       repeat { loop down the device chain }
  299.          Print_Header(Device,Hdr_Seg,Hdr_Offs);
  300.  
  301.          { Get next header location }
  302.          Hdr_Seg:= Device^.Next_Hdr_Seg;
  303.          Hdr_Offs:=Device^.Next_Hdr_Offs;
  304.  
  305.          Device:=PTR(Device^.Next_Hdr_Seg,Device^.Next_Hdr_Offs);
  306.       until ( Device^.Next_Hdr_Offs = $FFFF );    { Until last Header }
  307.  
  308.       Print_Header(Device,Hdr_Seg,Hdr_Offs);
  309.       Finish_Screen
  310.    end
  311.    else writeln('Error Opening Nul: device; error=',Error:1,'.');
  312.    repeat until KeyPressed;
  313. end.
  314.